Gravel Scatter new
scatter_fig_new <- function(x_col = "reach", y_col = "stack",
x_label = "Reach", y_label = "Stack",
x_info = NULL, y_info = NULL,
digits = 0,
jitter_x = 0, jitter_y = 0,
annotate_model = NULL,
data = my_fit){
#shared_data <- highlight_key(data, ~model)
if(is.null(x_info)){x_info <- x_label}
if(is.null(y_info)){y_info <- y_label}
n_colors <- length(levels(data[, restyle]))
my_palette <- pal_okabe_ito_4[1:n_colors]
min_data_x <- min(geobike[, get(x_col)])
max_data_x <- max(geobike[, get(x_col)])
min_data_y <- min(geobike[, get(y_col)])
max_data_y <- max(geobike[, get(y_col)])
x_min <- min_data_x - 0.1*(max_data_x - min_data_x)
x_max <- max_data_x + 0.1*(max_data_x - min_data_x)
y_min <- min_data_y - 0.1*(max_data_y - min_data_y)
y_max <- max_data_y + 0.1*(max_data_y - min_data_y)
setorder(geobike, cols = "restyle")
geobike[, restyle := factor(restyle,
levels = c("All-Road","Endurance","Trail"))]
fig <- geobike %>%
plot_ly(
type = 'scatter',
x = ~get(x_col),
y = ~get(y_col),
text = ~paste(model, frame_size,
"<br>Cat:", restyle,
paste0("<br>", x_info, ":"), round(get(x_col), digits),
paste0("<br>", y_info, ":"), round(get(y_col), digits)),
hoverinfo = 'text',
mode = 'markers',
color = ~restyle,
colors = pal_okabe_ito_3,
# marker = list(color = ~restyle,
# colors = pal_okabe_ito_3,
# size = 10),
transforms = list(
list(
type = 'filter',
target = ~frame_size_working,
operation = '=',
value = levels(geobike$frame_size_working)[3]
)
)) %>% layout(
xaxis = list(title = x_label,
range = c(x_min, x_max),
tickfont = list(size = 16),
titlefont = list(size = 16)),
yaxis = list(title = y_label,
range = c(y_min, y_max),
tickfont = list(size = 16),
titlefont = list(size = 16)),
legend = list(font = list(size = 10),
itemsizing = "constant"),
title = list(text = paste(y_label, "vs.", x_label),
x = 0,
xanchor = "left"),
updatemenus = list(
list(
type = 'dropdown',
active = 2, # list starts at 0
buttons = list(
list(method = "restyle",
args = list("transforms[0].value", levels(geobike$frame_size_working)[1]),
label = levels(geobike$frame_size_working)[1]),
list(method = "restyle",
args = list("transforms[0].value", levels(geobike$frame_size_working)[2]),
label = levels(geobike$frame_size_working)[2]),
list(method = "restyle",
args = list("transforms[0].value", levels(geobike$frame_size_working)[3]),
label = levels(geobike$frame_size_working)[3]),
list(method = "restyle",
args = list("transforms[0].value", levels(geobike$frame_size_working)[4]),
label = levels(geobike$frame_size_working)[4]),
list(method = "restyle",
args = list("transforms[0].value", levels(geobike$frame_size_working)[5]),
label = levels(geobike$frame_size_working)[5]),
list(method = "restyle",
args = list("transforms[0].value", levels(geobike$frame_size_working)[6]),
label = levels(geobike$frame_size_working)[6])
)
)
)
)
return(fig)
}scatter_fig_all <- function(x_col = "reach", y_col = "stack",
x_label = "Reach", y_label = "Stack",
x_info = NULL, y_info = NULL,
digits = 0,
jitter_x = 0, jitter_y = 0,
annotate_model = NULL,
data = my_fit){
#shared_data <- highlight_key(data, ~model)
if(is.null(x_info)){x_info <- x_label}
if(is.null(y_info)){y_info <- y_label}
n_colors <- length(levels(data[, restyle]))
my_palette <- pal_okabe_ito_4[1:n_colors]
fig <- plot_ly(data, type = "scatter", mode = "markers",
x = ~jitter(get(x_col), jitter_x),
y = ~jitter(get(y_col), jitter_y),
color = ~restyle,
colors = my_palette,
size = 10,
opacity = 0.3,
name = ~model_size,
hoverinfo = "text",
text = ~paste(model, frame_size,
"<br>Cat:", restyle,
paste0("<br>", x_info, ":"), round(get(x_col), digits),
paste0("<br>", y_info, ":"), round(get(y_col), digits)),
showlegend = FALSE
) %>%
# left arrow: \U2B05
# up arrow: \U2B06
# down arrow: \U2B07
# SW arrow: \U2B0B
add_text(text = ~paste("\U2B05", model, frame_size),
textfont = list(size = 14, color = ~restyle),
color = ~restyle,
colors = my_palette, # doesn't do anything
symbol = "circle",
opacity = 1,
textposition = "right",
visible = "legendonly",
sort = FALSE,
showlegend = TRUE,
) %>%
layout(xaxis = list(title = x_label, tickfont = list(size = 16), titlefont = list(size = 16)),
yaxis = list(title = y_label, tickfont = list(size = 16), titlefont = list(size = 16)),
legend = list(font = list(size = 10),
itemsizing = "constant"),
title = list(text = paste(y_label, "vs.", x_label),
x = 0,
xanchor = "left"),
# updatemenus = list(
# list(
# type = "buttons",
# y = 0.8,
# buttons = list(
#
# list(method = "restyle",
# args = list(list("marker.opacity", 0.8), list("text.opacity", 0.8)),
# label = "dark"),
#
# list(method = "restyle",
# args = list(list("marker.opacity", 0.2), list("text.opacity", 0.8)),
# label = "light")))
# ),
NULL
)
if(!is.null(annotate_model)){
for(j in 1:length(annotate_model)){
fig <- fig %>% add_annotations(
x = data[model == annotate_model[j], get(x_col)],
y = data[model == annotate_model[j], get(y_col)],
text = paste(data[model == annotate_model[j], model],
data[model == annotate_model[j], year]),
xref = "x",
yref = "y",
showarrow = TRUE,
arrowhead = 1,
ax = 20,
ay = -20,
# arrowcolor = pal_okabe_ito_4[4],
arrowcolor = "black",
# font = list(color = pal_okabe_ito_4[4], size = 16)
font = list(color = "black", size = 16)
)
}
}
# add style legend -- cannot get color to show
# fig <- fig %>% add_annotations(
# x = 0,
# y = 1,
# xref = "paper",
# yref = "paper",
# text = paste0("\U23FA", "Race"),
# textfont = list(size = 10, color = pal_okabe_ito_4[1]),
# showarrow = F
# )
return(fig)
}geobike[model == "Alchemy Rogue"] model year frame_size seat_tube_length top_tube_effective_length
1: Alchemy Rogue 2022 XS 515 460
2: Alchemy Rogue 2022 S 538 500
3: Alchemy Rogue 2022 M 558 520
4: Alchemy Rogue 2022 L 575 545
5: Alchemy Rogue 2022 XL 591 560
6: Alchemy Rogue 2022 XXL 615 570
head_tube_length seat_tube_angle head_tube_angle chainstay_length wheelbase
1: 120 73.5 70.00 430 1001
2: 135 73.5 70.25 430 1022
3: 150 73.5 70.50 430 1040
4: 170 73.5 71.25 430 1051
5: 185 73.5 71.50 430 1067
6: 200 73.5 71.50 430 1080
bottom_bracket_drop fork_offset_rake stack reach standover stem_length
1: 72.5 50.74331 540 353 748 NA
2: 72.5 50.74895 555 371 775 NA
3: 72.5 49.94303 570 387 792 NA
4: 72.5 50.00690 592 398 815 NA
5: 72.5 50.55967 607 411 830 NA
6: 72.5 49.59340 622 420 842 NA
handlebar_width crank_length wheel_size tire_width_spec tire_width_max
1: NA NA 700 50 50
2: NA NA 700 50 50
3: NA NA 700 50 50
4: NA NA 700 50 50
5: NA NA 700 50 50
6: NA NA 700 50 50
trail bb_height model_size rear_center front_center seat_center
1: 77.39336 288.5 Alchemy Rogue XS 423.844 577.156 159.9553
2: 75.69146 288.5 Alchemy Rogue S 423.844 598.156 164.3985
3: 74.85481 288.5 Alchemy Rogue M 423.844 616.156 168.8417
4: 69.73349 288.5 Alchemy Rogue L 423.844 627.156 175.3584
5: 67.47412 288.5 Alchemy Rogue XL 423.844 643.156 179.8016
6: 68.49305 288.5 Alchemy Rogue XXL 423.844 656.156 184.2448
stack_reach front_rear rear_wheelbase front_wheelbase sta_hta seat_tube_v
1: 1.529745 1.361718 0.4234206 0.5765794 1.050000 493.7922
2: 1.495957 1.411264 0.4147202 0.5852798 1.046263 515.8450
3: 1.472868 1.453733 0.4075423 0.5924577 1.042553 535.0214
4: 1.487437 1.479686 0.4032769 0.5967231 1.031579 551.3213
5: 1.476886 1.517436 0.3972296 0.6027704 1.027972 566.6625
6: 1.480952 1.548107 0.3924482 0.6075518 1.027972 589.6741
seat_tube_h seat_v seat_h head_v head_h x1 y1 x2 y2 x3
1: 146.2679 540 159.9553 112.7631 41.04242 0 0 263.8887 467.5 776.844
2: 152.8003 555 164.3985 127.0588 45.61876 0 0 259.4455 482.5 794.844
3: 158.4806 570 168.8417 141.3962 50.07103 0 0 255.0023 497.5 810.844
4: 163.3088 592 175.3584 160.9781 54.64471 0 0 248.4856 519.5 821.844
5: 167.8531 607 179.8016 175.4399 58.70136 0 0 244.0424 534.5 834.844
6: 174.6694 622 184.2448 189.6647 63.46093 0 0 239.5992 549.5 843.844
y3 x4 y4 x5 y5 x6 y6 x7 y7 rear_x
1: 467.5 817.8864 354.7369 1001 0 423.844 -72.5 277.5761 493.7922 -423.844
2: 482.5 840.4628 355.4412 1022 0 423.844 -72.5 271.0438 515.8450 -423.844
3: 497.5 860.9150 356.1038 1040 0 423.844 -72.5 265.3635 535.0214 -423.844
4: 519.5 876.4887 358.5219 1051 0 423.844 -72.5 260.5352 551.3213 -423.844
5: 534.5 893.5454 359.0601 1067 0 423.844 -72.5 255.9909 566.6625 -423.844
6: 549.5 907.3049 359.8353 1080 0 423.844 -72.5 249.1746 589.6741 -423.844
rear_y seat_x seat_y head_x head_y crown_x crown_y front_x front_y
1: 0 -159.9553 467.5 353 467.5 394.0424 354.7369 577.156 0
2: 0 -164.3985 482.5 371 482.5 416.6188 355.4412 598.156 0
3: 0 -168.8417 497.5 387 497.5 437.0710 356.1038 616.156 0
4: 0 -175.3584 519.5 398 519.5 452.6447 358.5219 627.156 0
5: 0 -179.8016 534.5 411 534.5 469.7014 359.0601 643.156 0
6: 0 -184.2448 549.5 420 549.5 483.4609 359.8353 656.156 0
bottom_x bottom_y seattube_x seattube_y my_fit shape_id top_tube_size
1: 0 -72.5 277.5761 493.7922 FALSE 17 [460,526)
2: 0 -72.5 271.0438 515.8450 FALSE 17 [460,526)
3: 0 -72.5 265.3635 535.0214 TRUE 17 [460,526)
4: 0 -72.5 260.5352 551.3213 FALSE 17 [526,547)
5: 0 -72.5 255.9909 566.6625 FALSE 17 [547,565)
6: 0 -72.5 249.1746 589.6741 FALSE 17 [565,584)
frame_size_working restyle
1: [460,526) All-Road
2: [460,526) All-Road
3: [460,526) All-Road
4: [526,547) All-Road
5: [547,565) All-Road
6: [565,584) All-Roadgeobike[model == ""]Empty data.table (0 rows and 71 cols): model,year,frame_size,seat_tube_length,top_tube_effective_length,head_tube_length...put working code here into function
The filter for bike size works
x_info <- NULL
y_info <- NULL
x_label <- "Reach"
y_label <- "Stack"
x_col <- "reach"
y_col <- "stack"
annotate_model <- NULL
digits = 0
min_data_x <- min(geobike[, get(x_col)])
max_data_x <- max(geobike[, get(x_col)])
min_data_y <- min(geobike[, get(y_col)])
max_data_y <- max(geobike[, get(y_col)])
x_min <- min_data_x - 0.1*(max_data_x - min_data_x)
x_max <- max_data_x + 0.1*(max_data_x - min_data_x)
y_min <- min_data_y - 0.1*(max_data_y - min_data_y)
y_max <- max_data_y + 0.1*(max_data_y - min_data_y)
setorder(geobike, cols = "restyle")
geobike[, restyle := factor(restyle,
levels = c("All-Road","Endurance","Trail"))]
p <- geobike %>%
plot_ly(
type = 'scatter',
x = ~get(x_col),
y = ~get(y_col),
text = ~paste(model, frame_size,
"<br>Cat:", restyle,
paste0("<br>", x_info, ":"), round(get(x_col), digits),
paste0("<br>", y_info, ":"), round(get(y_col), digits)),
hoverinfo = 'text',
mode = 'markers',
color = ~restyle,
colors = pal_okabe_ito_3,
# marker = list(color = ~restyle,
# colors = pal_okabe_ito_3,
# size = 10),
transforms = list(
list(
type = 'filter',
target = ~frame_size_working,
operation = '=',
value = levels(geobike$frame_size_working)[3]
)
)) %>% layout(
xaxis = list(title = x_label,
range = c(x_min, x_max),
tickfont = list(size = 16),
titlefont = list(size = 16)),
yaxis = list(title = y_label,
range = c(y_min, y_max),
tickfont = list(size = 16),
titlefont = list(size = 16)),
legend = list(font = list(size = 10),
itemsizing = "constant"),
title = list(text = paste(y_label, "vs.", x_label),
x = 0,
xanchor = "left"),
updatemenus = list(
list(
type = 'dropdown',
active = 2, # list starts at 0
buttons = list(
list(method = "restyle",
args = list("transforms[0].value", levels(geobike$frame_size_working)[1]),
label = levels(geobike$frame_size_working)[1]),
list(method = "restyle",
args = list("transforms[0].value", levels(geobike$frame_size_working)[2]),
label = levels(geobike$frame_size_working)[2]),
list(method = "restyle",
args = list("transforms[0].value", levels(geobike$frame_size_working)[3]),
label = levels(geobike$frame_size_working)[3]),
list(method = "restyle",
args = list("transforms[0].value", levels(geobike$frame_size_working)[4]),
label = levels(geobike$frame_size_working)[4]),
list(method = "restyle",
args = list("transforms[0].value", levels(geobike$frame_size_working)[5]),
label = levels(geobike$frame_size_working)[5]),
list(method = "restyle",
args = list("transforms[0].value", levels(geobike$frame_size_working)[6]),
label = levels(geobike$frame_size_working)[6])
)
)
)
)
pThe filter for bike size and bike model
x_info <- NULL
y_info <- NULL
x_label <- "Reach"
y_label <- "Stack"
x_col <- "reach"
y_col <- "stack"
annotate_model <- NULL
digits = 0
min_data_x <- min(geobike[, get(x_col)])
max_data_x <- max(geobike[, get(x_col)])
min_data_y <- min(geobike[, get(y_col)])
max_data_y <- max(geobike[, get(y_col)])
x_min <- min_data_x - 0.1*(max_data_x - min_data_x)
x_max <- max_data_x + 0.1*(max_data_x - min_data_x)
y_min <- min_data_y - 0.1*(max_data_y - min_data_y)
y_max <- max_data_y + 0.1*(max_data_y - min_data_y)
setorder(geobike, frame_size_working, model)
geobike[, restyle := factor(restyle,
levels = c("All-Road","Endurance","Trail"))]
geobike[, model := factor(model)]
p <- geobike %>%
plot_ly(
type = 'scatter',
x = ~get(x_col),
y = ~get(y_col),
text = ~paste(model, frame_size_working,
"<br>Cat:", restyle,
paste0("<br>", x_info, ":"), round(get(x_col), digits),
paste0("<br>", y_info, ":"), round(get(y_col), digits)),
hoverinfo = 'text',
mode = 'markers',
name = ~ model,
color = ~restyle,
showlegend = FALSE,
# marker = list(color = ~restyle,
# colors = pal_okabe_ito_3,
# size = 10),
transforms = list(
list(
type = 'filter',
target = ~frame_size_working,
operation = '=',
value = levels(geobike$frame_size_working)[3]
)
)
) %>%
add_text(text = ~paste("\U2B05", model, frame_size_working),
name = ~model,
textfont = list(size = 12, color = ~restyle),
color = ~restyle,
# colors = my_palette, # doesn't do anything
symbol = "circle",
textposition = "right",
visible = "legendonly",
showlegend = TRUE,
) %>%
layout(
xaxis = list(title = x_label,
range = c(x_min, x_max)),
yaxis = list(title = y_label,
range = c(y_min, y_max)),
updatemenus = list(
list(
type = 'dropdown',
active = 2, # list starts at 0
buttons = list(
list(method = "update",
args = list("transforms[0].value", levels(geobike$frame_size_working)[1]),
label = levels(geobike$frame_size_working)[1]),
list(method = "update",
args = list("transforms[0].value", levels(geobike$frame_size_working)[2]),
label = levels(geobike$frame_size_working)[2]),
list(method = "update",
args = list("transforms[0].value", levels(geobike$frame_size_working)[3]),
label = levels(geobike$frame_size_working)[3]),
list(method = "update",
args = list("transforms[0].value", levels(geobike$frame_size_working)[4]),
label = levels(geobike$frame_size_working)[4]),
list(method = "update",
args = list("transforms[0].value", levels(geobike$frame_size_working)[5]),
label = levels(geobike$frame_size_working)[5]),
list(method = "update",
args = list("transforms[0].value", levels(geobike$frame_size_working)[6]),
label = levels(geobike$frame_size_working)[6])
)
)
)
)
pa <- 1:10
b <- 1:10
text <- LETTERS[seq(1,10)]
data <- data.frame(a,b,text)
annotations = list()
for (i in 1:length(data[,1])) {
annotation <- list(x = data$a[i],
y = data$b[i],
text = data$text[i],
showarrow = TRUE)
annotations[[i]] <- annotation
}
updatemenus <- list(
list(
type= 'buttons',
buttons = list(
list(
label = "ON",
method = "update",
args = list(list(),
list(annotations = annotations))),
list(
label = "OFF",
method = "update",
args = list(list(),
list(annotations = list(c()))))
)
)
)
p <- plot_ly(data = data, x = ~a, y = ~b, type = "scatter", mode = "lines")
p <- layout(p, annotations = annotations, updatemenus = updatemenus)
p